library(tidyverse)
library(hrbrthemes)
library(ggforce)
library(viridis)
library(GGally)
library(corrplot)
library(ggrepel)
library(ggthemes)
Pasirinkite duomenų rinkinį (pvz. UCI Machine Learning Repository). Suformuluokite tyrimo tikslą, parinkite tinkamus tiesioginio vizualizavimo metodus (skirtingo tipo grafikų ir diagramų tiek kiek studentų grupelėje). Realizuokite naudodami pasirinktą R paketą.
Duomenys iš: https://github.com/rfordatascience/tidytuesday/tree/master/data/2018/2018-10-23
Originalus duomenų šaltinis: https://www.the-numbers.com/
Tikslas: Išsiaiškinti populiariausių ir pelningiausių filmų savybes ir kokiems žiūrovams jie yra kuriami
# Duomenų sutvarkymas
movies_data<- read_csv("movie_profit.csv")
movies_data <- movies_data %>%
mutate(release_date = lubridate::mdy(release_date), mpaa_rating = as.factor(mpaa_rating))
movies <- movies_data %>%
mutate(profit = worldwide_gross - production_budget,
year = lubridate::year(release_date),
month = lubridate::month(release_date),
season = case_when(
month %in% 3:5 ~ "Spring",
month %in% 6:8 ~ "Summer",
month %in% 9:11 ~ "Autumn",
TRUE ~ "Winter"
),
decade = round(year,-1),
ratio = worldwide_gross/production_budget,
season = fct_rev(factor(season,levels=c("Spring","Summer","Autumn","Winter"))),
genre = case_when(
genre == "Action" ~ "Veiksmo",
genre == "Horror" ~ "Siaubo",
genre == "Comedy" ~ "Komedija",
genre == "Adventure" ~ "Nuotyki\u0173",
TRUE ~ "Drama")) %>%
filter(year >= 1970)
levels(movies$season) <- c("Pavasaris","Vasara","Ruduo","\u017Diema")
movies %>% select(year, release_date, worldwide_gross, production_budget, profit, genre, movie) %>% filter(year >=1990) %>% top_n(50, worldwide_gross) -> bubble_data
ylab <- c(0.6,0.65,0.7,0.75,0.8,0.85,0.9,0.95,1,1.05,1.1,1.15,1.2,1.25,1.3,1.35)
bubble_data %>%
arrange(desc(profit)) %>%
ggplot(aes(x=release_date, y=worldwide_gross, size = production_budget, color = genre)) +
geom_point(alpha = 0.5) +
scale_y_continuous(labels = paste0(format(round(ylab, 2), nsmall = 2), ""),
breaks = 10^9 * ylab) +
geom_text_repel(data = subset(bubble_data, profit > 800000000), inherit.aes= FALSE,
aes(x=release_date, y=worldwide_gross, label=movie)) +
scale_size_area("Biudžetas (mil.)", breaks = 10^6 * c(40, 80, 120, 160),
labels = c(40, 80, 120, 160), max_size = 10)+
scale_color_manual("Žanras", values = c("#66C2A5","#c4c400","#E78AC3","#8a2be2")) +
labs(x="Išleidimo data", y = "Uždarbis pasaulio rinkoje(mlrd.)",
title = "50 populiariausių pasaulio filmų",
subtitle = "Pagal žanrą ir biudžetą")+
theme_gdocs() +
theme(plot.background = element_blank())
ggplot(drop_na(movies,mpaa_rating),aes(fct_reorder(genre,mpaa_rating,function(x) mean(x=="R")),fill=mpaa_rating)) +
geom_bar(position="fill",color=NA) +
scale_fill_viridis_d("MPAA reitingas",
guide=guide_legend(title.position = "top",
direction = "horizontal",
reverse = TRUE)) +
coord_flip() +
scale_y_continuous(labels=scales::label_percent()) +
theme_ipsum() +
labs(y="Dalis film\u0173",
x="Žanras",
title="Holivudo film\u0173 am\u017Eiaus reitingas pagal \u017Eanr\u0105",
subtitle="1970-2020 met\u0173 filmai") +
theme(legend.position="bottom")
scatter_data <- movies %>% group_by(genre,season) %>% mutate(vid = mean(production_budget))
ggplot(scatter_data,aes(x=vid,y=fct_rev(season),color=genre)) +
geom_point(size=8) +
theme_ipsum() +
scale_color_brewer("\u017Danras",
palette="Set2",
guide=guide_legend(direction = "horizontal")) +
labs(x="Vidutinis uždarbis pasaulio rinkoje (mil.)",
y="Met\u0173 laikas",
title = "Film\u0173 uždarbis pasaulio rinkoje",
subtitle="Pagal žanrą ir metų laikus") +
theme(legend.position = "bottom") + scale_x_continuous(limits=c(0,NA)) +
scale_x_continuous(breaks = 10^6 * c(0,20, 40, 60), labels = c(0,20, 40, 60),limits=c(0,NA))
point_data_2<- movies %>%
group_by(decade) %>%
summarize(ratio = mean(domestic_gross/worldwide_gross,na.rm=TRUE))
ggplot(point_data_2,aes(x=decade, y=ratio)) +
geom_point(size=8,color="skyblue") +
theme_ipsum() + geom_hline(yintercept=0.5,size=1) +
labs(x="Dešimtmetis",
y="Dalis u\u017Edarbio JAV rinkoje",
title="Film\u0173 u\u017Edarbis vietos (JAV) ir tarptautin\u0117je rinkoje",
subtitle="Vis didesn\u0117 dalis u\u017Edirbama tarptautin\u117je rinkoje") +
scale_y_continuous(labels = scales::label_percent()
,limits = c(0.4,1),
breaks=c(0.5,0.75,1))
Pavyzdžiu iliustruokite vieną iš šių geometrinio tiesioginio duomenų vizualizavimo metodų: Andrews kreivės, perstatymų matrica, apžiūros grafikas, lygiagrečiosios koordinatės, spindulinio vizualizavimo.
Duomenys iš: https://www.kaggle.com/yamaerenay/spotify-dataset-19212020-160k-tracks
spot<- read_csv("spotify_full.csv")
by_decade<- spot %>% mutate(decade = floor(year/10)*10) %>% filter(decade %in% c(1950,1980,2010))
by_decade %>% select(decade, acousticness, danceability, energy, instrumentalness, liveness, speechiness, valence) -> gd
gd$decade <- factor(gd$decade)
ggparcoord(gd, columns = 2:8, groupColumn = 1, showPoints = FALSE, alphaLines = .15 , scale = "uniminmax")+
labs(x = "", y ="") +
scale_color_viridis_d("Decade",guide=guide_legend(override.aes = list(alpha=1,size=1))) +
theme_ipsum() +
theme(plot.title = element_text(size=10))
Pavyzdžiu iliustruokite pasirinktą simbolinį tiesioginio duomenų vizualizavimo metodą naudodami R.
star_data <- spot %>% group_by(year) %>% summarize(across(where(is.numeric),mean)) %>% filter(year > 2000) %>% filter( year < 2021)
star_data$mode <- NULL
stars(star_data[,2:14], scale = TRUE, label = star_data$year, radius = TRUE, full = TRUE, main = "")
Savu pavyzdžiu iliustruokite koreliacijos koeficientų vizualizavimą naudojant R paketą corrplot (žr. https://cran.r-project.org/web/packages/corrplot/vignettes/corrplot-intro.html) panaudodami du skirtingus vizualizavimo būdus.
nums <- unlist(lapply(spot, is.numeric))
mdata<- spot[ , nums]
mdata$key <- NULL
mdata$mode <- NULL
mdata$year <- NULL
mdata$duration_ms <- NULL
mdata$liveness <- NULL
mdata$explicit <- NULL
mdata$tempo <- NULL
M<- cor(mdata)
corrplot(M, order = "FPC", method = "ellipse")
corrplot(M, order = "FPC", method = "color",type="upper",diag=FALSE,tl.col = "black", addCoef.col = "black")